perm filename CLEFXG.F4[NEW,LCS]3 blob sn#293486 filedate 1977-07-04 generic text, type T, neo UTF8
00100		SUBROUTINE CLEFS
00200		DIMENSION KPNT1(11),JCLEF(2100),RCMIN(4),KPNT2(11),KCLEF(350)
00300		1,CM(4),LCLEF(350),KPNT3(11),MCLEF(350),NCLEF(350),ICLEF(350)
00400		1,KPNT4(11),KPNT5(11),KPNT6(11),KPNT7(11),JJCLEF(350)
00500		COMMON /STF/RSTFAC(8),RSTJ2 /PLTR/IPLT,RHT,DIS,XDIS/BM/F,G,H
00600		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /MIN/MINI,RMINI
00700	      DATA RCMIN/3.3,10.5,7.0,10.5/,CM/.1,1.5,1.1,1.5/
00800		EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J9,JQ(7)),(KK,
00900		1 KPNT2(11)),(R6,RJQ(4)),(R5,RJQ(3)),(R8,RJQ(6)),(R7,RJQ(5))
01000		1,(DEG,R9,RJQ(7)),(NJR,RJQ(8)),(KJ,KPNT1(11)),(KCLEF,JCLEF(351))
01100		1,(R3,RJQ(1)),(LCLEF,JCLEF(701)),(KL,KPNT3(11)),(KM,KPNT4(11))
01200		1,(MCLEF,JCLEF(1051)),(NCLEF,JCLEF(1401)),(KN,KPNT5(11))
01300		1,(KI,KPNT6(11)),(ICLEF,JCLEF(1751)),(KJJ,KPNT7(11))
01400		1,(JJCLEF,JCLEF(2101)),(J8,JQ(6))
01500	CX	J5=MOD(J5,100)
01600	CX	IF(J5)J5=-J5
01700		CALL NOZERO(R6)
01800		IF(R7.EQ.0)R7=R6
01900	C  IF P7 = 0, IT WILL EQUAL P6.
02000		IF(JA.GT.10)GO TO 9
02100		NAME='CLEFA'
02200		IF(J5.LT.20)GO TO 4
02300		R6=R6*.3
02400	C  SIZE FACTORS FOR SPECIAL WORDS, ETC. (PPP, MF, CRESC. ETC.)
02500		R7=R7*.3
02600		GO TO 4
02700	9	IF(NAME.EQ.NJR)GO TO 4
02800		IF(NAME.EQ.0)GO TO 177
02900		IF(NJR.EQ.0)GO TO 4
03000	177	IF(NJR.EQ.0)GO TO 8	
03100	C  TO PICK UP BASIC DRAW NAME FROM P10 
03200		NAME=NJR
03300		GO TO 4
03400	8	TYPE 5
03500	5	FORMAT(' SET P10=1'/)
03600	C  LEADS TO PROPER FILE CALL
03700	4	NM=NAME+2*(J5/10)
03800	C  DRAW0 HAS ITEMS 0→9;  DRAW1, 10→19; ETC. TO DRAW9, 90→99
03900		JEZ=MOD(J5,10)+1
04000	2	IF(NM.EQ.NM1)GO TO 30
04100		IF(NM.EQ.NM2)GO TO 30
04200		IF(NM.EQ.NM3)GO TO 30
04300		IF(NM.EQ.NM4)GO TO 30
04400		IF(NM.EQ.NM5)GO TO 30
04500		IF(NM.EQ.NM6)GO TO 30
04600		IF(NM.EQ.NM7)GO TO 30
04700	C  SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
04800	C  JUMP IF ALREADY IN CORE
04900		NPP=0
05000		IF(JA.NE.11)GO TO 1111
05100	C  DOESN'T CHECK LOOKUP ON CLEFS AND ALPHA'S.
05200		NPP=-1
05300		IF(LOOKF(NM))GO TO 1111
05400		TYPE 1112,NM
05500		RETURN
05600	1112	FORMAT(1XA5,' -- NOT FOUND')
05700		KX=0
05800	1111	CALL GETFI2(NM,NPP)
05900		GO TO(33,233,333,433,533,633),KX
06000	C  GOES TO 133 WHEN KX IS 0
06100	133	KX=1
06200		NM1=NM
06300		CALL FASTI2(KPNT1,11)
06400		CALL FASTI2(JCLEF,KJ)
06500	C  NEW DATA READER  6/74 -- 5/75  HOLDS 3 .DMD FILES IF THEY FIT.
06600		IF(KJ.LE.350)GO TO 30
06700		KX=0
06800		NM2=0
06900		GO TO 30
07000	33	CALL FASTI2(KPNT2,11)
07100		IF(KK.GT.350)GO TO 1112
07200	C  JUMP BACK IF IT WON'T FIT.
07300		CALL FASTI2(KCLEF,KK)
07400		NM2=NM
07500		KX=2
07600		GO TO 30
07700	233	CALL FASTI2(KPNT3,11)
07800		IF(KL.GT.350)GO TO 1112
07900	C  JUMP BACK IF IT WON'T FIT.
08000		CALL FASTI2(LCLEF,KL)
08100		KX=3
08200		NM3=NM
08300	C   CHECK THE ABOVE  -- FOR P5 HEIGHT CHANGE *********************
08400	C  R6 IS SIZE FACTOR
08500		GO TO 30
08600	333	CALL FASTI2(KPNT4,11)
08700		IF(KM.GT.350)GO TO 1112
08800	C  JUMP BACK IF IT WON'T FIT.
08900		CALL FASTI2(MCLEF,KM)
09000		KX=4
09100		NM4=NM
09200		GO TO 30
09300	433	CALL FASTI2(KPNT5,11)
09400		IF(KN.GT.350)GO TO 1112
09500	C  JUMP BACK IF IT WON'T FIT.
09600		CALL FASTI2(NCLEF,KN)
09700		KX=5
09800		NM5=NM
09900		GO TO 30
10000	533	CALL FASTI2(KPNT6,11)
10100		IF(KN.GT.350)GO TO 1112
10200	C  JUMP BACK IF IT WON'T FIT.
10300		CALL FASTI2(ICLEF,KI)
10400		KX=6
10500		NM6=NM
10600		GO TO 30
10700	633	CALL FASTI2(KPNT7,11)
10800		IF(KN.GT.350)GO TO 1112
10900	C  JUMP BACK IF IT WON'T FIT.
11000		CALL FASTI2(JJCLEF,KJJ)
11100		KX=0
11200		NM7=NM
11300	30	IF(J5.GT.3)GO TO 811
11400		IF(JA.NE.3)GO TO 811
11500	C  0=TREB, 1=BASS, 2=ALTO, 3=TENOR(ALTO SHIFTED UP)  MINI→R4+100
11600	C  ↑↑↑↑↑↑↑↑  FIXUP SOMEDAY IN .DMD FILES
11700		IF(IABS(J4).LT.80)GO TO 812
11800		RSTJ2=.8*RSTJ2
11900	C  TO SET HGT. OF MINI CLEFS
12000		R4=R4+CM(JEZ)
12100	C  SHIFTS MINIS UP BECAUSE OF WRONG ORIG. POS.??
12200	812	IF(JEZ.NE.4)GO TO 811
12300		R4=R4+2
12400		JEZ=3
12500	C   ABOVE IS NOW AT TOP
12600	
12700	811	A=R4
12800		R4=A+2.9
12900	C  ADJUSTS HEIGHT(??)
13000		CALL CENTX
13100		R4=A
13200	
13300		L=KPNT1(JEZ)
13400		IF(NM.EQ.NM2)L=KPNT2(JEZ)+350
13500		IF(NM.EQ.NM3)L=KPNT3(JEZ)+700
13600		IF(NM.EQ.NM4)L=KPNT4(JEZ)+1050
13700		IF(NM.EQ.NM5)L=KPNT5(JEZ)+1400
13800		IF(NM.EQ.NM6)L=KPNT6(JEZ)+1750
13900		IF(NM.EQ.NM7)L=KPNT7(JEZ)+2100
14000		IF(L.LE.0)RETURN
14100	C CATCHES IMPOSSIBLE NUMBERS (I HOPE!)
14200		IF(J9.EQ.0)GO TO 31
14300	C***** ROTATE *******
14400		R7=R7*RSTJ2
14500		R6=R6*RSTJ2
14600		N=JCLEF(L)
14700		KNT=701
14800	C ROTATED DATA IS PUT STARTING AT LOCATION 701.(AREA FOR NM3)******
14900		JCLEF(KNT)=N
15000		DO 1 K=L+1,N+L-1
15100		CALL UNPACK(J,M,JCLEF(K))
15200		X=J*R6
15300		Y=M*R7
15400		JJ=JCLEF(K)/100000000
15500		AX=ATAN2(X,Y)*57.29578
15600		HYP=SQRT(X**2+Y**2)
15700		ROT=DEG+AX
15800		J=ROFF(HYP*COSD(ROT))
15900		M=ROFF(HYP*SIND(ROT))
16000		KNT=KNT+1
16100		IF(J)J=1000-J
16200		IF(M)M=1000-M
16300	1	JCLEF(KNT)=M*10000+J+JJ*100000000
16400		L=701
16500	C  ***********  SEE AT TOP **********
16600		R6=1.
16700		R7=1.
16800		RSTJ2=1.
16900	C  SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
17000	CC	CALL ROTATE(JCLEF,L)
17100		NM3=0
17200	C  WIPES OUT DATA AREA FOR NM3
17300	C  R9=P9=DEGREES OF ROTATION (0-360)
17400		IF(KK.GT.350)KX=0
17500	C CHECK TO SEE IF DATA WAS WIPED OUT.
17600	31	A=-1
17700	C  FLAG FOR THICKNESS OR NO.
17800		IF(J8.EQ.-2)GO TO 32
17900		IF(R8.LE.0)GO TO 34
18000		A=0
18100	C NEXT J8 = 1→99 =X THICKNESS, =100→ = Y THICKNESS
18200		CALL THICK
18300	C  SEE CLEFZ.F4 FOR "THICK" CODE  (THICK IS IN MFAIL.FAI)
18400		GO TO 32
18500	CC34	IF(IPLT)GO TO 77
18600	CC31	IF(R8.EQ.-2)GO TO 32
18700	C			R8=-2 OMITS FILLER DURING PLOT
18800	CCC	IF(IPLT)GO TO 77
18900	34	IF(IPLT)77,77,32
19000	CCCC	IF(R8.NE.-1)GO TO 32
19100	77	DO 3 K=L+1,JCLEF(L)+L
19200		IF(JCLEF(K).LT.200000000)GO TO 3
19300		JEZ=JCLEF(L)-1
19400		IF(K.GT.L+1)JEZ=JEZ-K+L+1
19500		CALL FILLMS(JEZ,JCLEF(K),R3,CENTR,R6,R7)
19600		GO TO 32
19700	3	CONTINUE
19800	C  FILLS ONLY WHEN PLOTING OR R8=-1
19900	32	CALL JDRAW(JCLEF(L),R3,CENTR,RSTJ2,R6,R7)
20000	C   3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, R8=-1 TO FILL ON CRT
20100		IF(A)RETURN
20200		IF(J8.NE.0)GO TO 234
20300		IF(J9.EQ.0)RETURN
20400		GO TO 134
20500	234	J8=J8-1
20600		R3=R3+XDIS
20700	C  XDIS=1 PLOTTER STEP NO MATTER WHAT SIZE FACTOR USED
20800	134	IF(J9.EQ.0)GO TO 32
20900		J9=J9-1
21000		CENTR=CENTR+XDIS
21100		GO TO 32
21200	
21300		END